home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Belgian Amiga Club - ADF Collection
/
BS1 part 21.zip
/
BS1 part 21
/
Professional Page v4.0 (1993)(Gold Disk)(Disk 1 of 4)[HD].7z
/
Professional Page v4.0 (1993)(Gold Disk)(Disk 1 of 4)[HD].adf
/
pagegenies.lzh
/
Avery Labels.pgen
< prev
next >
Wrap
Text File
|
1992-03-11
|
6KB
|
261 lines
/*
@B@LLabel Generator.pprx@b Copyright Gold Disk Inc., February, 1992
This Genie will read one of several Avery Label databases contained in the current directory and allow the user to create a variety of labels.
*/
parse arg sourcedir
cr = '0a'x
address command
call SafeEndEdit.rexx()
call ppm_AutoUpdate(0)
units = getclip(ppgenie_units)
call ppm_SetUnits(1)
labels = ''
counter = 0
address command
list = getdirlist.rexx(sourcedir, ".db")
if list = '' then exit_msg("Unable to find label data:ase. Please reinstall!")
selection = ppm_SelectFromList("Select Type of label..", 35, 5, 0, list)
if selection = '' then exit_msg()
filename = sourcedir"/"selection".db"
if ~open(file, filename, "r") then exit_msg("An error has occured reading database")
call ppm_ShowStatus("Reading label database..")
line = readln(file)
if pos('LASER', line) ~= 0 then
labeltype = laser
else if pos('MATRIX', line) ~= 0 then
labeltype = matrix
else
exit_msg("Invalid database file")
spos = Pos('PAGESIZE', line)
if spos ~= 0 then
do
line = substr(line, spos + 8)
opageh = word(line, 2)
opagev = word(line, 1)
end
else
do
opageh = 0
opagev = 0
end
lcounter = 0
do while ~eof(file)
line = strip(readln(file))
if line = '' | left(line, 2) = '\*' | left(line, 2) = '*/' then
iterate
lcounter = lcounter + 1
parse var line code ';' name ';' .
code = strip(code)
name = strip(name)
text = code || copies(" ", max(1,12 - length(code))) || name
lines.lcounter.0 = line
lines.lcounter.1 = text
labels = labels||cr||text
end
labels = delstr(labels,1,1)
label = ppm_SelectFromList("Select Label..", 40, 10, 0, labels)
if label = '' then exit_msg()
do i = 0 to lcounter - 1
cline = lines.i.1
if cline = label then leave
end
line = lines.i.0
group = 0
if ppm_GroupFirstBox() ~= 0 then
do
if ppm_Inform(2,"Would like like to tile the current group to create labels?", "No","Yes") then group = 1
end
else if ppm_BoxNum() ~= 0 then
do
if ppm_BoxPage() ~= 0 then
if ppm_Inform(2,"Would like like to tile the current box to create labels?", "No","Yes") then group = 2
end
if labeltype = laser then
do
sline = compress(line)
parse var sline pnum ';' type ';' lheight ';' lwid ';' cols ';' rows ';' topmarg ';' sidemarg ';' hpitch ';' vpitch ';' .
if ~exists("rexx:GroupTile.pprx") then
exit_msg("Unable to locate Genie named: rexx:GroupTile.pprx")
npages = ppm_GetForm("How many pages will you need?", 8, "Pages:1")
if npages = '' then exit_msg()
if ~datatype(npages, n) then exit_msg("Invalid entry")
newpage = ppm_CreatePage(ppm_CurrentPage() + 1,1,0,0,0)
if opagev ~= 0 then
call ppm_SetPageSize(newpage, opagev, opageh)
call ppm_GotoPage(newpage)
if group = 2 then
do
call ppm_NewGroup()
call ppm_AddToGroup(ppm_BoxNum())
call TileGroup(sidemarg,topmarg,lwid, lheight, cols, rows, hpitch, vpitch)
end
else if group = 1 then
do
call TileGroup(sidemarg,topmarg,lwid, lheight, cols, rows, hpitch, vpitch)
end
else
do
call ppm_NewGroup()
box = ppm_CreateBox(sidemarg, topmarg, lwid, lheight, 0)
call ppm_AddToGroup(box)
call TileGroup(sidemarg,topmarg,lwid,lheight,cols,rows, hpitch, vpitch)
end
message = "Done"
end
else
do
sline = compress(line)
parse var sline pnum ';' type ';' lheight ';' lwid ';' cols ';' cwidth ';' hpitch ';' vpitch ';' .
npages = ppm_GetForm("How many Pages of Dot Matrix Labels?", 18, "Number of labels:"1)
if npages = '' then exit_msg()
if ~datatype(npages, n) then exit_msg("Invalid input")
if vpitch < 1 then vpitch = 1
hspace = hpitch - lwid
lmarg = (cwidth - (cols * hpitch - hpitch + lwid)) / 2
tmarg = (vpitch - lheight) / 2
newpage = ppm_CreatePage(ppm_CurrentPage() + 1, 1, 0, 0, 0)
call ppm_SetPageSize(newpage, cwidth, vpitch)
call ppm_GotoPage(newpage)
if group = 2 then
do
call ppm_NewGroup()
call ppm_AddToGroup(ppm_BoxNum())
call TileGroup(lmarg,tmarg,lwid, lheight, cols, 1, hpitch, vpitch)
end
else if group = 1 then
do
call TileGroup(lmarg,tmarg,lwid, lheight, cols, 1, hpitch, vpitch)
end
else
do
call ppm_NewGroup()
box = ppm_CreateBox(lmarg, tmarg, lwid, lheight, 0)
call ppm_AddToGroup(box)
call TileGroup(lmarg,tmarg,lwid, lheight, cols, 1, hpitch, vpitch)
call ppm_DeleteBox(box)
end
call ppm_SetDMEject(0)
call ppm_SetDMPageSize(cwidth, vpitch)
cwidth = ppm_ConvertUnits(1, units, cwidth)
vpitch = ppm_ConvertUnits(1, units, vpitch)
if units = 1 then unit = "inches"
else if units = 2 then unit = "CM"
else if units = 3 then unit = "Picas"
message = "Done. The Dot Matrix Page Eject has been turned off and the output page size has been set to "cwidth" "unit" x "vpitch" "unit
end
npages = npages - 1
cpage = ppm_CurrentPage()
do npages
call ppm_CopyPage(cpage, cpage + 1, 1)
cpage = cpage + 1
end
exit_msg(message)
exit_msg: procedure expose units
do
parse arg message
if message ~= '' then call ppm_Inform(1,message,)
call ppm_ClearStatus()
call ppm_SetUnits(units)
call ppm_AutoUpdate(1)
exit
end
TileGroup: procedure expose newpage
do
parse arg sidemarg, topmarg, lwid, lheight, cols, rows, hpitch, vpitch
i = 0
box = ppm_GroupFirstBox()
do while box ~= 0
i = i + 1
newbox.i = ppm_CloneBox(box, 0, 0)
if ppm_TextOverFlow(box) then
do
call ppm_DeleteContents(newbox.i)
call ppm_TextIntoBox(newbox.i, ppm_GetArticleText(box, 1))
end
call ppm_BoxChangePage(newbox.i, newpage)
box = ppm_GroupNextBox(box)
end
call ppm_NewGroup()
do x = 1 to i
call ppm_AddToGroup(newbox.x)
end
grouprect = ppm_GetGroupRect()
xscale = lwid / word(grouprect, 3) * 100
yscale = lheight / word(grouprect, 4) * 100
address command
call GroupScale.pprx(xscale, yscale)
xsp = hpitch - lwid
ysp = vpitch - lheight
call GroupTile.pprx(sidemarg, topmarg, rows, cols, xsp, ysp)
return
end